home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMIBEST1.ADF / AmigaBasicStuff / WaveForm / Waveform Workshop (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-07-22  |  15KB  |  668 lines
  1. '***********************************************************
  2. '*                                                         *      
  3. '*              W A V E F O R M   W O R K S H O P          *      
  4. '*                                                         *      
  5. '*                      By James Shields                   *      
  6. '*                                                         *      
  7. '*                                                         *      
  8. '* Waveform Workshop allows the user to see and build      *
  9. '* waveforms and save them as BASIC readable files, for    *
  10. '* use in other programs.                                  *                   
  11. '*                                                         *      
  12. '***********************************************************
  13.  
  14. Main:
  15.  
  16.    GOSUB constants     'Set up the constants and arrays
  17.    GOSUB mainscreen    'Set up the main screen
  18.    GOSUB waveedit      'Edit waves
  19.    CLOSE               'clean up
  20.    WINDOW CLOSE 1
  21.    WINDOW 1,,,,-1
  22.    END
  23.  
  24. '* Begin Subroutine *'
  25.  
  26. constants:    'set up program constants and arrays
  27.  
  28.    OPTION BASE 0
  29.    DIM wav%(256),pat%(1)
  30.    DIM savewave%(256),demo!(13)
  31.    
  32. ' calculate note data for sound demo
  33.    
  34.    FOR i=0 TO 12
  35.       demo!(i+1) = INT(263*((2^(i/12))))
  36.    NEXT i
  37.    wavename$="Noname"           'Name the wave
  38.    filename$="No file"          'Tell where it came from
  39.    pat%(0)=255
  40.    pat%(1)=255                  'Set up pattern fill data
  41.    FOR i%=1 TO 128
  42.       wav%(i%-1)=127              'Set up initial wave data
  43.       wav%(256-i%)=-127
  44.    NEXT i%
  45.    WAVE 0,wav%
  46.    WAVE 1,wav%
  47.    WAVE 2,wav%
  48.    true% = (1=1)                'Symbolic boolean constants are
  49.    false% = (1=0)               'used throughout.
  50.    notsaved% = false%
  51.    firstwave%=true%             'First time through 
  52.    
  53. RETURN
  54.  
  55. '* Begin Subroutine *'
  56.  
  57. mainscreen:                     'main wave editing screen
  58.                     
  59. SCREEN 1,640,200,3,2
  60. WINDOW 1,"Waveform Workshop",,0,1
  61. WINDOW OUTPUT 1
  62.  
  63. PALETTE 1,0.6,0.6,0.6              'define colors used
  64. PALETTE 0,0,0,0
  65. PALETTE 2,1,0.9,0
  66. PALETTE 3,0.1,1,0.3
  67. PALETTE 1,1,1,1
  68. PALETTE 5,1,0.1,0.1
  69. PALETTE 6,0.8,0.13,0.83
  70. PALETTE 7,0.27,0.47,1
  71.  
  72. black  = 0                   'Use symbolic names for colors
  73. grey   = 1                   'rather than color numbers.
  74. yellow = 2                   'Saves wear and tear on programmers'
  75. green  = 3                   'brains.
  76. white  = 4
  77. red    = 5
  78. purple = 6
  79. blue   = 7
  80.  
  81. CLS                          'Set the colors in use.
  82. GOSUB mousereset
  83.  
  84. RETURN
  85.  
  86. '* Begin Subroutine *'
  87.  
  88. mousereset:     'wait until the mouse button is released
  89.  
  90. WHILE MOUSE(0) <>0
  91. WEND
  92. RETURN
  93.  
  94. '* Begin Subroutine *'
  95.  
  96. waveedit:                   'Set up the screen to edit
  97. CLS
  98. terminate% = false%         'We don't want to stop.
  99. GOSUB wavescreen            'Display the screen.
  100. WHILE NOT terminate%
  101. LOCATE 1,1
  102. PRINT SPACE$(65);           'Print the wave name and origin.
  103. LOCATE 1,3
  104. COLOR purple,black
  105. PRINT "Waveform:  ";wavename$;TAB(40);
  106. PRINT "Filename:  ";filename$
  107. COLOR blue,black
  108.    waitformouse1:                         'get a command.
  109.       IF MOUSE(0)=0 THEN waitformouse1    
  110.    x=MOUSE(1)
  111.    y=MOUSE(2)
  112.    IF (x<532) OR (x>545) THEN          'if there's an error
  113.        PALETTE 0,1,1,1                 'flash the screen
  114.        FOR i=1 TO 50
  115.        NEXT i
  116.        PALETTE 0,0,0,0
  117.        WHILE MOUSE(0) <> 0
  118.           WEND
  119.        GOTO waitformouse1
  120.    END IF
  121.  
  122. 'Process the function selected.   
  123.        
  124.    playwave%     = ((y>15) AND (y<23))  
  125.    newwave%      = ((y>31) AND (y<39)) 
  126.    editwave%     = ((y>47) AND (y<55)) 
  127.    displaywave%  = ((y>63) AND (y<71)) 
  128.    namewave%     = ((y>79) AND (y<87))
  129.    savewave%     = ((y>95) AND (y<103))
  130.    loadwave%     = ((y>111) AND (y<119))
  131.    noise%        = ((y>127) AND (y<135))
  132.    exitwave%     = ((y>1) AND (y<9))
  133.    
  134.    IF playwave%    THEN GOSUB playwave
  135.    IF newwave%     THEN GOSUB newwave
  136.    IF editwave%    THEN GOSUB editwave
  137.    IF displaywave% THEN GOSUB displaywave
  138.    IF namewave%    THEN GOSUB namewave
  139.    IF savewave%    THEN GOSUB savewave
  140.    IF loadwave%    THEN GOSUB loadwave
  141.    IF noise%       THEN GOSUB noise
  142.    IF exitwave%    THEN GOSUB exitwave
  143.    
  144.    GOSUB mousereset    
  145.    
  146.    WEND
  147.  
  148. firstwave%=false%
  149. RETURN
  150.  
  151. '* Begin Subroutine *'
  152.  
  153. wavescreen:             'Print the main editing screen.
  154.  
  155. CLS
  156. CALL box(533,1,544,8,grey)
  157. LOCATE 1,70
  158. COLOR blue,black
  159. PRINT "Exit"
  160. CALL box(9,9,523,138,yellow)
  161. LINE (10,74)-(522,74),yellow
  162. LOCATE 3,70
  163. COLOR blue,black
  164. PRINT "Play"
  165. LOCATE 5,70
  166. CALL box(533,16,544,22,grey)    
  167. PRINT "New "
  168. CALL box(533,32,544,38,grey) 
  169. LOCATE 7,70
  170. PRINT "Edit"
  171. CALL box(533,48,544,54,grey)
  172. LOCATE 9,70
  173. PRINT "Display"
  174. CALL box(533,64,544,70,grey)
  175. LOCATE 11,70
  176. PRINT "Name"
  177. CALL box(533,80,544,86,grey)
  178. LOCATE 13,70
  179. PRINT "Save"
  180. CALL box(533,96,544,102,grey)
  181. LOCATE 15,70
  182. CALL box(533,112,544,118,grey)
  183. PRINT "Load"
  184. CALL box(533,128,544,134,grey)
  185. LOCATE 17,70
  186. PRINT "Noise"
  187.  
  188. RETURN
  189.  
  190. '* Begin Subroutine *'
  191.  
  192. playwave:                   'Demonstrate the sound 
  193. GOSUB chords
  194. playvave%=false%
  195. RETURN
  196.    
  197. '* Begin Subroutine *'
  198.  
  199. chords:         'Play a scale and chords to demonstrate
  200. SOUND RESUME    'the waveform sound.
  201.  
  202. SOUND demo!(1)/2,3    'c
  203. SOUND demo!(3)/2,3    'd
  204. SOUND demo!(5)/2,3    'e
  205. SOUND demo!(6)/2,3    'f
  206. SOUND demo!(8)/2,3    'g
  207. SOUND demo!(10)/2,3   'a
  208. SOUND demo!(12)/2,3   'b
  209. SOUND demo!(1),3    'c
  210. SOUND demo!(3),3    'd
  211. SOUND demo!(5),3    'e
  212. SOUND demo!(6),3    'f
  213. SOUND demo!(8),3    'g
  214. SOUND demo!(10),3   'a
  215. SOUND demo!(12),3   'b
  216. SOUND demo!(1)*2,3  'c
  217. SOUND demo!(3)*2,3  'd
  218. SOUND demo!(5)*2,3  'e
  219. SOUND demo!(6)*2,3  'f
  220. SOUND demo!(8)*2,3  'g
  221. SOUND demo!(10)*2,3 'a
  222. SOUND demo!(12)*2,3 'b
  223. SOUND demo!(13)*2,3 'c1
  224. SOUND WAIT                     'Syncronize the first chord.
  225. 'C
  226. SOUND demo!(1)*2,20,140,0  'c
  227. SOUND demo!(8),20,140,1    'g
  228. SOUND demo!(1),20,140,2    'c
  229.  
  230. SOUND RESUME
  231. 'F
  232. SOUND demo!(10),20,140,0   'a
  233. SOUND demo!(6),20,140,1    'f
  234. SOUND demo!(1),20,140,2    'c
  235. 'G
  236. SOUND demo!(3),20,140,0    'd
  237. SOUND demo!(8),20,140,1    'g
  238. SOUND demo!(12),20,140,2   'b
  239. 'C
  240. SOUND demo!(1)*2,20,140,0  'c
  241. SOUND demo!(8),20,140,1    'g
  242. SOUND demo!(1),20,140,2    'c
  243.  
  244. RETURN
  245.  
  246. '* Begin Subroutine *'
  247.  
  248. newwave:                    'Clear the old wave out
  249. IF notsaved THEN GOSUB saveerror
  250. GOSUB cleargraph
  251. FOR i%=1 TO 128
  252.       wav%(i%-1)=127             
  253.       wav%(256-i%)=-127
  254. NEXT i%
  255. wavename$="Noname"
  256. filename$="No file"
  257. notsaved = false%
  258. newwave%=false%
  259. RETURN
  260.  
  261. '* Begin Subroutine *'
  262.  
  263. editwave:                    'Actually edit the wave 
  264. GOSUB clearbottom            'Clear the dialogue window
  265. COLOR yellow,black
  266. LOCATE 23,5
  267. PRINT "Compile wave";
  268. CALL box(8,176,20,182,grey)
  269. LOCATE 22,5
  270. PRINT "Exit edit"
  271. CALL box(8,166,20,172,grey)
  272. GOSUB mousereset
  273. mouseloop:                   'Draw what is pointed to.
  274. IF MOUSE(0)=0 THEN      'If user released mouse button
  275.    lastx=0              'Keep from drawing a bogus segment
  276.    lasty=0
  277.    GOTO mouseloop
  278. END IF   
  279. x=MOUSE(1)
  280. y=MOUSE(2)
  281.  
  282. 'Check to see if a command was selected.
  283.  
  284. commandrange = ((x>7) AND (x<21))    
  285. IF (commandrange AND (y>165) AND (y<173)) THEN exitedit
  286. IF (commandrange AND (y>175) AND (y<183)) THEN compilewave
  287.  
  288. 'Check to see if the mouse is out of bounds.
  289.  
  290. IF (x<10) OR (x>522) OR (y<10) OR (y>137) THEN mouseloop
  291.  
  292. 'If all is well, draw the segment of the wave.
  293.  
  294. IF lastx =0 THEN 
  295.    lastx=x
  296.    lasty=y
  297. END IF
  298.    
  299. 'erase any segments in the same X plane as the new segment
  300. IF lastx<=x THEN s=1 :ELSE s= (-1)
  301.  
  302. COLOR black,black
  303. AREA(lastx,10)
  304. AREA STEP(ABS(lastx-x)*s,0)
  305. AREA STEP(0,127)
  306. AREA STEP(-(ABS(lastx-x))*s,0)
  307. AREAFILL
  308. LINE(lastx,74)-(x,74),yellow
  309. LINE(lastx,lasty)-(x,y),red     'Draw the new segment.
  310. lastx = x
  311. lasty = y
  312. GOTO mouseloop
  313.  
  314. 'Wave editor commands:
  315.  
  316. compilewave:
  317.    GOSUB recalcarray
  318.    notsaved%=true%
  319. RETURN
  320.  
  321. exitedit:
  322.    editwave%=false%
  323.    GOSUB clearbottom
  324.    COLOR blue,black
  325.  
  326. RETURN
  327.  
  328. '* Begin Subroutine *'
  329.  
  330. recalcarray:            'read the screen data
  331.  
  332. GOSUB clearbottom
  333. COLOR red,black
  334.  
  335. LOCATE 23,3
  336. lastpoint = 10
  337. wavedirection = 1  'is the wave rising or falling?
  338.  
  339. FOR i=0 TO 255
  340.    j = lastpoint
  341.    pointsscanned = 0
  342.       scan:
  343.       p=POINT(i*2+11,j)   
  344.       IF p=red THEN
  345.          IF (j<lastpoint) THEN wavedirection=(-1)
  346.          IF (j>lastpoint) THEN wavedirection=1
  347.          ' and if its neither leave it alone.
  348.          lastpoint = j
  349.          wav%(i)=127-(2*(j-9))
  350.          'bounds check
  351.          IF wav%(i)>127 THEN wav%(i)=127
  352.          IF wav%(i)<-128 THEN wav%(i)=-128
  353.          LINE(i*2+11,j)-(i*2+11,j),blue
  354.          GOTO nextpoint
  355.       END IF
  356.    j=j+(wavedirection)
  357.    pointsscanned = pointsscanned+1
  358.    IF (j<10) OR (j> 139) THEN
  359.        wavedirection = wavedirection * (-1)   
  360.        j = lastpoint
  361.    END IF    
  362.    IF pointsscanned<127 THEN GOTO scan    
  363.      'in case there is a blank space
  364. nextpoint:        
  365. NEXT i
  366.  
  367. GOSUB redrawwave
  368.  
  369. 'reset the waveforms for the demo
  370.  
  371. WAVE 0,wav%
  372. WAVE 1,wav%
  373. WAVE 2,wav%
  374.  
  375. 'clean up and exit
  376.  
  377. notsaved% = true%
  378. GOSUB clearbottom
  379. COLOR blue,black
  380. RETURN
  381.  
  382. '* Begin Subroutine *'
  383.  
  384. cleargraph:            'Clear the waveform graph 
  385.  
  386. PATTERN ,pat%
  387. AREA (10,10)
  388. AREA STEP(512,0)
  389. AREA STEP (0,128)
  390. AREA STEP (-512,0)
  391. COLOR black,black
  392. AREAFILL
  393. CALL box(9,9,523,139,yellow)
  394. LINE(10,74)-(522,74),yellow
  395. COLOR blue,black
  396.  
  397. RETURN
  398.  
  399. '* Begin Subroutine *'
  400.  
  401. displaywave:               'Display multiple waveforms 
  402.                            'at the bottom
  403.                            'of the screen.
  404. GOSUB clearbottom
  405. LINE(1,158)-(639,158),yellow
  406. FOR i=1 TO 256  STEP 2
  407.  
  408. 'Write out the smaller waveforms 5 times (for speed's sake)
  409.  
  410.    LINE(i/2+1,159-wav%(i)/8)-(i/2+1,159-wav%(i)/8),red
  411.    LINE(i/2+129,159-wav%(i)/8)-(i/2+129,159-wav%(i)/8),red
  412.    LINE(i/2+257,159-wav%(i)/8)-(i/2+257,159-wav%(i)/8),red
  413.    LINE(i/2+385,159-wav%(i)/8)-(i/2+385,159-wav%(i)/8),red
  414.    LINE(i/2+513,159-wav%(i)/8)-(i/2+513,159-wav%(i)/8),red
  415.  
  416. NEXT i
  417. COLOR blue,black   
  418. displaywave% = false%
  419.  
  420. RETURN
  421.  
  422. '* Begin Subroutine *'
  423.  
  424. redrawwave:               'Draw the wave in wav%()
  425.  
  426. GOSUB cleargraph
  427. lasty=wav%(0)
  428. FOR i=1 TO 256
  429.    LINE((i-1)*2+11,74-lasty/2)-(i*2+11,74-wav%(i-1)/2),red
  430.    lasty=wav%(i-1)
  431. NEXT i    
  432.  
  433. RETURN
  434.  
  435. '* Begin Subroutine *'
  436.  
  437. clearbottom:            'Clear the dialogue window.
  438.  
  439. COLOR black,black
  440. AREA (1,142)
  441. AREA STEP (630,0)
  442. AREA STEP(0,44)
  443. AREA STEP(-630,0)
  444. AREAFILL
  445.  
  446. RETURN
  447.  
  448. '* Begin Subroutine *'
  449.  
  450. namewave:              'Give the waveform a name.
  451. GOSUB clearbottom
  452. COLOR blue,black
  453. LOCATE 22,3
  454. INPUT "New name of wave";wavename$
  455. namewave%=false%
  456. GOSUB clearbottom
  457. COLOR blue,black
  458. RETURN
  459.  
  460. '* Begin Subroutine *'
  461.  
  462. savewave:               'Save the wave.
  463. CLOSE #1        'Just in case
  464. GOSUB clearbottom
  465. COLOR green,black
  466. LOCATE 22,3
  467. INPUT "Filename (10 characters or less, EXIT to quit)";filename$
  468. IF filename$="EXIT" THEN exitsave
  469. IF LEN(filename$)>10 THEN 
  470.     filename$=LEFT$(filename$,10)+".Wave"
  471. ELSE
  472.     filename$=filename$+".Wave"
  473. END IF
  474. ON ERROR GOTO newfile
  475.  
  476. 'An error should occur if the file is not there.  If it is,
  477. 'then we go on and try to save.  Actually, an error here 
  478. 'indicates that things are ok, and no error indicates things
  479. 'need to be checked out -- the wave already exists. 
  480.  
  481. OPEN filename$ FOR INPUT AS #1
  482. GOSUB clearbottom
  483. COLOR red,black
  484. LOCATE 22,3
  485. PRINT "File exists; erase it? ";
  486. GOSUB getyn
  487. IF (answer$="n") OR (answer$="N") THEN savewave
  488.  
  489. newfile:
  490. CLOSE #1      'Just in case it was open
  491.  
  492. OPEN filename$ FOR OUTPUT AS #1        
  493. FOR i=1 TO 256
  494.    WRITE #1,wav%(i)
  495.    LOCATE 23,3
  496.    PRINT "Saving point ";i;
  497. NEXT i
  498. CLOSE #1
  499.  
  500. exitsave:   
  501. savewave%=false%
  502. notsaved%=false%
  503. GOSUB clearbottom
  504. COLOR blue,black
  505.  
  506. RETURN
  507.  
  508. '* Begin Subroutine *'
  509.  
  510. loadwave:       'Load in a previously saved waveform.
  511.  
  512. loadwave%=false%
  513. GOSUB clearbottom
  514. COLOR blue,black
  515. LOCATE 22,3
  516. INPUT "Filename ";filename$
  517. IF RIGHT$(filename$,5) <> ".Wave" THEN 
  518.        filename$=filename$+".Wave"
  519. END IF       
  520. CLOSE #1       'Just in case
  521. ON ERROR GOTO baddata
  522.  
  523. 'Here, an error is really an error.
  524.  
  525. OPEN filename$ FOR INPUT AS #1
  526. FOR i=0 TO 255
  527.    INPUT #1,wav%(i)
  528.    LOCATE 23,3
  529.    PRINT "Reading point ";i;
  530. NEXT i
  531. CLOSE #1
  532. wavename$=LEFT$(filename$,LEN(filename$)-5)
  533. GOTO endload
  534.  
  535. baddata:
  536. GOSUB clearbottom
  537. COLOR red,black
  538. LOCATE 22,3
  539. PRINT "Unable to load file ";filename$;".  ";
  540. IF ERR=53 THEN  
  541.    PRINT "File not found." 
  542. ELSE
  543.    PRINT "File error."   
  544. END IF
  545. PRINT "   Try again? ";
  546. GOSUB getyn
  547. IF answer$="y" OR answer$="Y" THEN GOTO loadwave
  548.  
  549. endload:
  550. notsaved% = false%
  551. GOSUB clearbottom
  552. COLOR blue,black
  553. GOSUB redrawwave
  554.  
  555. RETURN
  556.  
  557. '* Begin Subroutine *'
  558.  
  559. noise:       'Add noise to the waveform.
  560.  
  561.  
  562. noise%=false%
  563. checkloop:
  564. GOSUB clearbottom
  565. COLOR blue,black
  566. LOCATE 22,3
  567. INPUT "Percentage of noise";noiseamount
  568. IF noiseamount>100 THEN GOTO checkloop
  569. FOR i=1 TO 256
  570.    savewave%(i)=wav%(i)   'Temporarily save the old wave.
  571.    IF (RND*100)<noiseamount THEN wav%(i)=127-INT(RND*256)
  572. NEXT i
  573.  
  574. GOSUB redrawwave   'Show the noisy wave.
  575. WAVE 0,wav%
  576. WAVE 1,wav%
  577. WAVE 2,wav%
  578.  
  579. GOSUB chords       'See what it sounds like.
  580. GOSUB clearbottom
  581. COLOR blue,black
  582.  
  583. LOCATE 23,3
  584. PRINT "Use this wave? ";
  585. GOSUB getyn
  586.    IF (answer$="Y") OR (answer$="y") THEN exitnoise1
  587.    FOR i=1 TO 256
  588.       wav%(i)=savewave%(i)     'Restore the old wave
  589.    NEXT i
  590.    GOSUB clearbottom
  591.    GOSUB redrawwave
  592.    COLOR blue,black
  593.    LOCATE 23,3
  594.    PRINT "Try again? ";
  595.    GOSUB getyn
  596.    IF (answer$="n") OR (answer$="N") THEN exitnoise
  597. GOTO loop3 
  598.    
  599. exitnoise1:
  600. notsaved% = true%
  601.  
  602. exitnoise:   
  603. GOSUB clearbottom
  604. COLOR blue,black
  605.  
  606. RETURN
  607.  
  608.  
  609. '* Begin Subroutine *'
  610.  
  611. exitwave:    'Finish up.
  612.  
  613. LOCATE 1,1
  614. PRINT SPACE$(80);
  615. LOCATE 1,2
  616. COLOR red,black
  617. PRINT "Exit wave selected."
  618. IF notsaved% THEN GOSUB saveerror
  619. terminate%=true%
  620. exitwave%=false%
  621. RETURN
  622.  
  623.  
  624. '* Begin Subroutine *'
  625.  
  626. initwaves:              'Zero the waveform arrays.
  627.  
  628. FOR i =0 TO 255
  629.    wav%(i)=0
  630. NEXT i
  631.  
  632. RETURN
  633.  
  634. '* Begin Subroutine *'
  635.  
  636. saveerror:                   'Check to be sure the user  
  637.                              'wants to abandon the wave.
  638. GOSUB clearbottom            'Clear the dialogue window.
  639. LOCATE 22,3
  640. PRINT "Changes made since last save.  Do you want to save?";
  641. GOSUB getyn
  642. IF (answer$="y") OR (answer$="Y") THEN GOSUB savewave
  643.  
  644. RETURN
  645.  
  646. '* Begin Subroutine *'
  647.  
  648. getyn:                       'Get a yes or no reply.
  649. ynloop:
  650. answer$=INKEY$
  651. IF answer$="" THEN ynloop
  652. IF (answer$<>"Y") AND (answer$<>"N") AND (answer$<>"y") AND (answer$<>"n") THEN ynloop
  653. RETURN
  654.  
  655. SUB box (x1,y1,x2,y2,colr) STATIC        'Draw a box.
  656.  
  657. 'Note that the numbers in the call must be long integers.
  658. 'constants must have a ! behind them, as in 511!.
  659.  
  660. LINE (x1,y1)-(x1,y2),colr
  661. LINE (x1,y1)-(x2,y1),colr
  662. LINE (x2,y1)-(x2,y2),colr
  663. LINE (x2,y2)-(x1,y2),colr
  664.  
  665. END SUB
  666.  
  667.  
  668.